home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / Obrn-A_1.6_lib.lha / oberon-a / source3.lha / source / Kernel / Kernel_1.4.mod < prev    next >
Text File  |  1995-06-04  |  7KB  |  226 lines
  1. (**************************************************************************
  2.  
  3.      $RCSfile: Kernel_1.4.mod $
  4.   Description: Oberon-A run-time support module.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.3 $
  8.       $Author: fjc $
  9.         $Date: 1994/11/11 16:48:27 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of Oberon-A.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.   _________________________________________________________________________
  15.  
  16.   Module Kernel will have a unique status in the Oberon-A system,
  17.   starting with Release 1.5. It will implement the startup and exit code
  18.   for each program, as well as the run-time support code for standard
  19.   procedures such as NEW that are too large or complex to be generated
  20.   inline by the compiler. Currently these tasks are handled by the code
  21.   in OberonSys.lib, which is written in assembly language. However, this
  22.   will require changes to the compiler to remove defunct procedures in
  23.   module SYSTEM and to change hard-coded assumptions about the calling
  24.   conventions and linker symbols of procedures in the run-time support
  25.   code.
  26.  
  27.   This module is provided to help smooth the transition, without waiting
  28.   for Release 1.5. It provides what will hopefully be close to the
  29.   interface to the final module Kernel, but uses the features of the
  30.   current Release 1.4 module SYSTEM to implement them.
  31.  
  32.   Existing code should be modified now to use module Kernel instead of
  33.   the extended features that are due to be removed from module SYSTEM.
  34.   These are:
  35.  
  36.     SYSTEM.ARGLEN and SYSTEM.ARGS -- replace with the fromWorkbench,
  37.       dosCmdBuf, dosCmdLen and WBenchMsg variables exported by module
  38.       Kernel.
  39.     SYSTEM.SETCLEANUP -- replace with Kernel.SetCleanup.
  40.     SYSTEM.GC -- replace with Kernel.GC.
  41.     SYSTEM.GETNAME -- replace with Kernel.Name.
  42.     SYSTEM.SIZETAG -- replace with Kernel.Size.
  43.     SYSTEM.NEWTAG -- replace with Kernel.NewFromTag.
  44.     SYSTEM.NEW -- when using the optional memory requirements parameter,
  45.       use Kernel.New.
  46.  
  47. **************************************************************************)
  48.  
  49. <* STANDARD- *>
  50. <* INITIALISE- *>
  51. <* MAIN- *>
  52.  
  53. MODULE Kernel ["OberonSys.lib"];
  54.  
  55. (* Turn off ALL compiler checks. *)
  56.  
  57. <*$ CaseChk- IndexChk- NilChk- RangeChk- StackChk- TypeChk- OvflChk- *>
  58.  
  59. IMPORT SYS := SYSTEM;
  60.  
  61. TYPE
  62.  
  63.   STRPTR = POINTER [1] TO ARRAY 32767 OF CHAR;
  64.  
  65. (*-----------------------------------------------------------------------**
  66. ** These variables are used to hold the arguments passed to the program  **
  67. ** by AmigaDOS or Workbench. Do NOT make them writeable.                 **
  68. **-----------------------------------------------------------------------*)
  69.  
  70. VAR
  71.  
  72.   fromWorkbench -: BOOLEAN;  (* TRUE if the program was started from
  73.                              ** Workbench, FALSE if it was started by a
  74.                              ** Shell or CLI.
  75.                              *)
  76.  
  77.   dosCmdBuf     -: STRPTR;   (* When started from a Shell or CLI, this
  78.                              ** variable will hold the command line used
  79.                              ** to run the program. Only valid if
  80.                              ** fromWorkbench is FALSE.
  81.                              *)
  82.  
  83.   dosCmdLen     -: LONGINT;  (* The length in characters of the command
  84.                              ** line. Only valid if fromWorkbench is
  85.                              ** FALSE.
  86.                              *)
  87.  
  88.   WBenchMsg     -: SYS.CPTR; (* The startup message sent to the program
  89.                              ** by Workbench. Only valid if fromWorkbench
  90.                              ** is TRUE. This must be cast to a
  91.                              ** Workbench.WBStartupPtr to gain access to
  92.                              ** the arguments.
  93.                              *)
  94.  
  95.  
  96. (*-----------------------------------------------------------------------**
  97. ** These types are used to implement the automatic cleanup system.       **
  98. **-----------------------------------------------------------------------*)
  99.  
  100. TYPE
  101.  
  102.   CleanupProc * = PROCEDURE (VAR rc : LONGINT);
  103.  
  104.   CleanupPtr = POINTER [1] TO CleanupRec;
  105.   CleanupRec = RECORD [1]
  106.     link : CleanupPtr;
  107.     proc : CleanupProc;
  108.   END; (* CleanupRec *)
  109.  
  110.  
  111. (*-----------------------------------------------------------------------**
  112. ** This variable is used to hold the list of installed cleanup           **
  113. ** procedures.                                                           **
  114. **-----------------------------------------------------------------------*)
  115.  
  116. VAR
  117.  
  118.   cleanupList : CleanupPtr;
  119.  
  120. (*-----------------------------------------------------------------------*)
  121.  
  122. PROCEDURE* DoCleanup;
  123.  
  124.   VAR rc : LONGINT; cleanupPtr : CleanupPtr;
  125.  
  126. BEGIN (* DoCleanup *)
  127.   (* Execute any installed cleanup procedures. *)
  128.  
  129.   rc := SYS.RC(); cleanupPtr := cleanupList;
  130.   cleanupList := NIL; (* This avoids loops if an error occurs in a
  131.                       ** cleanup procedure.
  132.                       *)
  133.   WHILE cleanupPtr # NIL DO
  134.     cleanupPtr.proc (rc);
  135.     cleanupPtr := cleanupPtr.link
  136.   END;
  137. END DoCleanup;
  138.  
  139.  
  140. (* SetCleanup() installs a procedure that will be executed automatically
  141. ** when the program exits.
  142. *)
  143.  
  144. PROCEDURE SetCleanup * ( proc : CleanupProc );
  145.  
  146.   VAR newCleanup : CleanupPtr;
  147.  
  148. BEGIN (* SetCleanup *)
  149.   NEW (newCleanup); ASSERT (newCleanup # NIL, 25);
  150.   newCleanup.link := cleanupList; cleanupList := newCleanup;
  151.   newCleanup.proc := proc
  152. END SetCleanup;
  153.  
  154.  
  155. (* Size() returns the size in bytes of the record type whose type tag
  156. ** is passed as a parameter. The type tag is obtained by a call to
  157. ** SYSTEM.TAG.
  158. *)
  159.  
  160. PROCEDURE Size * ( type : SYS.TYPETAG ) : LONGINT;
  161.  
  162.   VAR size : LONGINT;
  163.  
  164. BEGIN (* Size *)
  165.   ASSERT (type # NIL, 132);
  166.   RETURN SYS.SIZETAG (type)
  167. END Size;
  168.  
  169.  
  170. (* Name() copies the name of the type whose type tag is passed as a
  171. ** parameter into a string variable. The type tag is obtained by a call to
  172. ** SYSTEM.TAG.
  173. *)
  174.  
  175. PROCEDURE Name * ( type : SYS.TYPETAG; VAR buf : ARRAY OF CHAR );
  176.  
  177. BEGIN (* Name *)
  178.   ASSERT (type # NIL, 132);
  179.   SYS.GETNAME (type, buf)
  180. END Name;
  181.  
  182.  
  183. (* NewFromTag() allocates a new record from the type tag passed as a
  184. ** parameter. The type tag is obtained by a call to SYSTEM.TAG.
  185. *)
  186.  
  187. PROCEDURE NewFromTag * ( VAR v : SYS.PTR; type : SYS.TYPETAG );
  188. BEGIN (* NewFromTag *)
  189.   ASSERT (type # NIL, 132);
  190.   SYS.NEWTAG (v, type)
  191. END NewFromTag;
  192.  
  193.  
  194. (* New() allocates a block of memory, with a specific set of memory
  195. ** requirements. The memory requirements are the same as those used by
  196. ** Exec.AllocMem().
  197. *)
  198.  
  199. PROCEDURE New * ( VAR v : SYS.CPTR; size : LONGINT; reqs : SET );
  200. BEGIN (* New *)
  201.   SYS.NEW (v, size, reqs)
  202. END New;
  203.  
  204.  
  205. (*
  206. ** GC is a straight replacement for SYSTEM.GC
  207. *)
  208.  
  209. PROCEDURE GC *;
  210. BEGIN
  211.   SYS.GC
  212. END GC;
  213.  
  214. BEGIN (* Kernel *)
  215.   SYS.ARGLEN (dosCmdLen);
  216.   fromWorkbench := (dosCmdLen < 0);
  217.   IF fromWorkbench THEN
  218.     dosCmdBuf := NIL;
  219.     SYS.ARGS (SYS.VAL (LONGINT, WBenchMsg))
  220.   ELSE
  221.     SYS.ARGS (SYS.VAL (LONGINT, dosCmdBuf));
  222.     WBenchMsg := NIL
  223.   END;
  224.   SYS.SETCLEANUP (DoCleanup)
  225. END Kernel.
  226.